home *** CD-ROM | disk | FTP | other *** search
/ Visual Basic Source Code / Visual Basic Source Code.iso / vbsource / ownrdclb / frmlines.frm (.txt) < prev    next >
Encoding:
Visual Basic Form  |  1998-06-28  |  14.9 KB  |  433 lines
  1. VERSION 5.00
  2. Object = "{72D18DD4-0DA7-11D2-8E21-00B404C10000}#2.1#0"; "ODCBOLST.OCX"
  3. Begin VB.Form frmLineStyle 
  4.    BorderStyle     =   3  'Fixed Dialog
  5.    Caption         =   "Owner Draw Combo Box Client Draw Demo"
  6.    ClientHeight    =   2850
  7.    ClientLeft      =   3945
  8.    ClientTop       =   1740
  9.    ClientWidth     =   5790
  10.    Icon            =   "frmLineStyle.frx":0000
  11.    LinkTopic       =   "Form1"
  12.    MaxButton       =   0   'False
  13.    MinButton       =   0   'False
  14.    ScaleHeight     =   2850
  15.    ScaleWidth      =   5790
  16.    ShowInTaskbar   =   0   'False
  17.    Begin VB.PictureBox picTexture 
  18.       AutoRedraw      =   -1  'True
  19.       AutoSize        =   -1  'True
  20.       BorderStyle     =   0  'None
  21.       Height          =   1920
  22.       Index           =   4
  23.       Left            =   4440
  24.       Picture         =   "frmLineStyle.frx":0442
  25.       ScaleHeight     =   1920
  26.       ScaleWidth      =   1920
  27.       TabIndex        =   10
  28.       Tag             =   "Dark Sky"
  29.       Top             =   4440
  30.       Visible         =   0   'False
  31.       Width           =   1920
  32.    End
  33.    Begin VB.PictureBox picTexture 
  34.       AutoRedraw      =   -1  'True
  35.       AutoSize        =   -1  'True
  36.       BorderStyle     =   0  'None
  37.       Height          =   1920
  38.       Index           =   3
  39.       Left            =   4080
  40.       Picture         =   "frmLineStyle.frx":0E9F
  41.       ScaleHeight     =   1920
  42.       ScaleWidth      =   1920
  43.       TabIndex        =   9
  44.       Tag             =   "Liquid Metal"
  45.       Top             =   4020
  46.       Visible         =   0   'False
  47.       Width           =   1920
  48.    End
  49.    Begin VB.PictureBox picTexture 
  50.       AutoRedraw      =   -1  'True
  51.       AutoSize        =   -1  'True
  52.       BorderStyle     =   0  'None
  53.       Height          =   1920
  54.       Index           =   2
  55.       Left            =   3600
  56.       Picture         =   "frmLineStyle.frx":16E6
  57.       ScaleHeight     =   1920
  58.       ScaleWidth      =   1920
  59.       TabIndex        =   8
  60.       Tag             =   "Soap Stone"
  61.       Top             =   3660
  62.       Visible         =   0   'False
  63.       Width           =   1920
  64.    End
  65.    Begin VB.PictureBox picTexture 
  66.       AutoRedraw      =   -1  'True
  67.       AutoSize        =   -1  'True
  68.       BorderStyle     =   0  'None
  69.       Height          =   1920
  70.       Index           =   1
  71.       Left            =   3240
  72.       Picture         =   "frmLineStyle.frx":1BDB
  73.       ScaleHeight     =   1920
  74.       ScaleWidth      =   1920
  75.       TabIndex        =   7
  76.       Tag             =   "Green Blur"
  77.       Top             =   3300
  78.       Visible         =   0   'False
  79.       Width           =   1920
  80.    End
  81.    Begin VB.PictureBox picTexture 
  82.       AutoRedraw      =   -1  'True
  83.       AutoSize        =   -1  'True
  84.       BorderStyle     =   0  'None
  85.       Height          =   1920
  86.       Index           =   0
  87.       Left            =   3180
  88.       Picture         =   "frmLineStyle.frx":21C4
  89.       ScaleHeight     =   1920
  90.       ScaleWidth      =   1920
  91.       TabIndex        =   6
  92.       Tag             =   "Pink Granite"
  93.       Top             =   2940
  94.       Visible         =   0   'False
  95.       Width           =   1920
  96.    End
  97.    Begin ODCboLst.OwnerDrawComboList cboBackTexture 
  98.       Height          =   360
  99.       Left            =   3060
  100.       TabIndex        =   5
  101.       Top             =   360
  102.       Width           =   2715
  103.       _ExtentX        =   4789
  104.       _ExtentY        =   635
  105.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  106.          Name            =   "Tahoma"
  107.          Size            =   8.25
  108.          Charset         =   0
  109.          Weight          =   400
  110.          Underline       =   0   'False
  111.          Italic          =   0   'False
  112.          Strikethrough   =   0   'False
  113.       EndProperty
  114.       ForeColor       =   -2147483630
  115.       ClientDraw      =   2
  116.    End
  117.    Begin ODCboLst.OwnerDrawComboList cboLineDash 
  118.       Height          =   360
  119.       Left            =   120
  120.       TabIndex        =   3
  121.       Top             =   1200
  122.       Width           =   2715
  123.       _ExtentX        =   4789
  124.       _ExtentY        =   635
  125.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  126.          Name            =   "Tahoma"
  127.          Size            =   8.25
  128.          Charset         =   0
  129.          Weight          =   400
  130.          Underline       =   0   'False
  131.          Italic          =   0   'False
  132.          Strikethrough   =   0   'False
  133.       EndProperty
  134.       ForeColor       =   -2147483630
  135.       ClientDraw      =   2
  136.    End
  137.    Begin ODCboLst.OwnerDrawComboList cboLineStyle 
  138.       Height          =   360
  139.       Left            =   120
  140.       TabIndex        =   0
  141.       Top             =   360
  142.       Width           =   2715
  143.       _ExtentX        =   4789
  144.       _ExtentY        =   635
  145.       BeginProperty Font {0BE35203-8F91-11CE-9DE3-00AA004BB851} 
  146.          Name            =   "Tahoma"
  147.          Size            =   8.25
  148.          Charset         =   0
  149.          Weight          =   400
  150.          Underline       =   0   'False
  151.          Italic          =   0   'False
  152.          Strikethrough   =   0   'False
  153.       EndProperty
  154.       ForeColor       =   -2147483630
  155.       ClientDraw      =   2
  156.    End
  157.    Begin VB.Image imgTexture 
  158.       BorderStyle     =   1  'Fixed Single
  159.       Height          =   1935
  160.       Left            =   3060
  161.       Top             =   780
  162.       Width           =   1935
  163.    End
  164.    Begin VB.Label lblBackTexture 
  165.       Caption         =   "&Texture:"
  166.       BeginProperty Font 
  167.          Name            =   "Tahoma"
  168.          Size            =   8.25
  169.          Charset         =   0
  170.          Weight          =   400
  171.          Underline       =   0   'False
  172.          Italic          =   0   'False
  173.          Strikethrough   =   0   'False
  174.       EndProperty
  175.       Height          =   195
  176.       Left            =   3060
  177.       TabIndex        =   4
  178.       Top             =   120
  179.       Width           =   2775
  180.    End
  181.    Begin VB.Label lblDashed 
  182.       Caption         =   "&Dashed:"
  183.       BeginProperty Font 
  184.          Name            =   "Tahoma"
  185.          Size            =   8.25
  186.          Charset         =   0
  187.          Weight          =   400
  188.          Underline       =   0   'False
  189.          Italic          =   0   'False
  190.          Strikethrough   =   0   'False
  191.       EndProperty
  192.       Height          =   255
  193.       Left            =   120
  194.       TabIndex        =   2
  195.       Top             =   960
  196.       Width           =   2655
  197.    End
  198.    Begin VB.Label lblLineStyle 
  199.       Caption         =   "&Style:"
  200.       BeginProperty Font 
  201.          Name            =   "Tahoma"
  202.          Size            =   8.25
  203.          Charset         =   0
  204.          Weight          =   400
  205.          Underline       =   0   'False
  206.          Italic          =   0   'False
  207.          Strikethrough   =   0   'False
  208.       EndProperty
  209.       Height          =   255
  210.       Left            =   120
  211.       TabIndex        =   1
  212.       Top             =   120
  213.       Width           =   2655
  214.    End
  215. Attribute VB_Name = "frmLineStyle"
  216. Attribute VB_GlobalNameSpace = False
  217. Attribute VB_Creatable = False
  218. Attribute VB_PredeclaredId = True
  219. Attribute VB_Exposed = False
  220. Option Explicit
  221. Private Declare Function GetFocus Lib "user32" () As Long
  222. Private Sub cboBackTexture_Click()
  223. Dim lIndex As Long
  224.     lIndex = cboBackTexture.ItemData(cboBackTexture.ListIndex)
  225.     If (lIndex = -1) Then
  226.         Set imgTexture.Picture = Nothing
  227.     Else
  228.         Set imgTexture.Picture = picTexture(lIndex).Picture
  229.     End If
  230. End Sub
  231. Private Sub cboBackTexture_DrawItem(Index As Long, hdc As Long, bSelected As Boolean, bEnabled As Boolean, LeftPixels As Long, TopPixels As Long, RightPixels As Long, BottomPixels As Long, hFntOld As Long)
  232. Dim tR As RECT
  233. Dim hBrush As Long
  234. Dim lY As Long
  235. Dim sText As String
  236. Dim iIndex As Long
  237. Dim tFR As RECT
  238.     tR.left = LeftPixels
  239.     tR.tOp = TopPixels
  240.     tR.Bottom = BottomPixels
  241.     tR.Right = RightPixels
  242.     If (bSelected) Then
  243.         hBrush = CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT))
  244.     Else
  245.         hBrush = CreateSolidBrush(GetSysColor(COLOR_WINDOW))
  246.     End If
  247.     FillRect hdc, tR, hBrush
  248.     DeleteObject hBrush
  249.     If (GetFocus() = cboBackTexture.hwnd) And bSelected Then
  250.         DrawFocusRect hdc, tR
  251.     End If
  252.         
  253.     If (Index <> -1) Then
  254.         If (cboBackTexture.ItemOverLine(Index)) Then
  255.             DrawLine hdc, tR.left, tR.Right, tR.tOp, 1
  256.         End If
  257.         ' Blit the texture at 2,2->96,height-4:
  258.         iIndex = cboBackTexture.ItemData(Index)
  259.         If (iIndex > -1) Then
  260.             BitBlt hdc, tR.left + 2, tR.tOp + 2, 64, (tR.Bottom - tR.tOp - 4), picTexture(iIndex).hdc, 0, 0, SRCCOPY
  261.         Else
  262.             tFR.left = tR.left + 2: tFR.tOp = tR.tOp + 2: tFR.Right = tFR.left + 64: tFR.Bottom = tFR.tOp + (tR.Bottom - tR.tOp - 4)
  263.             DrawFocusRect hdc, tFR
  264.         End If
  265.         tR.left = tR.left + 68
  266.         ' Draw the text:
  267.         SetBkMode hdc, TRANSPARENT
  268.         sText = cboBackTexture.List(Index)
  269.         DrawText hdc, sText, -1, tR, DT_LEFT
  270.     End If
  271. End Sub
  272. Private Sub cboBackTexture_MeasureItem(Index As Long, WidthPixels As Long, HeightPixels As Long)
  273.     WidthPixels = cboBackTexture.Width \ Screen.TwipsPerPixelX
  274.     HeightPixels = (cboBackTexture.Height * 2) \ Screen.TwipsPerPixelY
  275. End Sub
  276. Private Sub cboLineDash_DrawItem(Index As Long, hdc As Long, bSelected As Boolean, bEnabled As Boolean, LeftPixels As Long, TopPixels As Long, RightPixels As Long, BottomPixels As Long, hFntOld As Long)
  277. Dim tR As RECT
  278. Dim hBrush As Long
  279. Dim lY As Long
  280.     tR.left = LeftPixels
  281.     tR.tOp = TopPixels
  282.     tR.Bottom = BottomPixels
  283.     tR.Right = RightPixels
  284.     If (bSelected) Then
  285.         hBrush = CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT))
  286.     Else
  287.         hBrush = CreateSolidBrush(GetSysColor(COLOR_WINDOW))
  288.     End If
  289.     FillRect hdc, tR, hBrush
  290.     DeleteObject hBrush
  291.     If (GetFocus() = cboLineDash.hwnd) And bSelected Then
  292.         DrawFocusRect hdc, tR
  293.     End If
  294.         
  295.     If (Index <> -1) Then
  296.         lY = tR.tOp + (tR.Bottom - tR.tOp) \ 2
  297.         DrawLine hdc, tR.left + 4, tR.Right - 4, lY, 1, cboLineDash.ItemData(Index)
  298.     End If
  299. End Sub
  300. Private Sub cboLineDash_MeasureItem(Index As Long, WidthPixels As Long, HeightPixels As Long)
  301.     WidthPixels = cboLineStyle.Width \ Screen.TwipsPerPixelX
  302.     HeightPixels = cboLineStyle.Height \ Screen.TwipsPerPixelY
  303. End Sub
  304. Private Sub cboLineStyle_DrawItem(Index As Long, hdc As Long, bSelected As Boolean, bEnabled As Boolean, LeftPixels As Long, TopPixels As Long, RightPixels As Long, BottomPixels As Long, hFntOld As Long)
  305. Dim tR As RECT
  306. Dim tTXR As RECT
  307. Dim sText As String
  308. Dim hBrush As Long
  309. Dim iLineWidth As Long
  310. Dim iLineStyle As Long
  311. Dim lY As Long
  312.     SetBkMode hdc, TRANSPARENT
  313.     tR.left = LeftPixels
  314.     tR.tOp = TopPixels
  315.     tR.Bottom = BottomPixels
  316.     tR.Right = RightPixels
  317.     If (bSelected) Then
  318.         hBrush = CreateSolidBrush(GetSysColor(COLOR_HIGHLIGHT))
  319.     Else
  320.         hBrush = CreateSolidBrush(GetSysColor(COLOR_WINDOW))
  321.     End If
  322.     FillRect hdc, tR, hBrush
  323.     DeleteObject hBrush
  324.     If (GetFocus() = cboLineStyle.hwnd) And bSelected Then
  325.         DrawFocusRect hdc, tR
  326.     End If
  327.     If (Index <> -1) Then
  328.                 
  329.         iLineWidth = cboLineStyle.ItemExtraData(Index)
  330.         iLineStyle = cboLineStyle.ItemData(Index)
  331.         sText = cboLineStyle.List(Index)
  332.         LSet tTXR = tR
  333.         tTXR.left = tTXR.left + 4
  334.         DrawText hdc, sText, -1, tTXR, DT_CALCRECT
  335.         DrawText hdc, sText, -1, tTXR, DT_LEFT
  336.         tR.left = 24
  337.         tR.Right = tR.Right - 4
  338.         Select Case iLineStyle
  339.         Case 1
  340.             ' single line:
  341.             lY = tR.tOp + (tR.Bottom - tR.tOp) \ 2
  342.             DrawLine hdc, tR.left, tR.Right, lY, (iLineWidth \ 100)
  343.         Case 2
  344.             ' two thin lines:
  345.             lY = tR.tOp + (tR.Bottom - tR.tOp) \ 2
  346.             lY = lY - 1
  347.             DrawLine hdc, tR.left, tR.Right, lY, 1
  348.             lY = lY + 1
  349.             DrawLine hdc, tR.left, tR.Right, lY, 1
  350.         Case 3
  351.             ' thin then thick:
  352.             lY = tR.tOp + (tR.Bottom - tR.tOp) \ 2
  353.             lY = lY - 2
  354.             DrawLine hdc, tR.left, tR.Right, lY, 1
  355.             lY = lY + 3
  356.             DrawLine hdc, tR.left, tR.Right, lY, 2
  357.         Case 4
  358.             ' thick then thin:
  359.             lY = tR.tOp + (tR.Bottom - tR.tOp) \ 2
  360.             lY = lY - 2
  361.             DrawLine hdc, tR.left, tR.Right, lY, 2
  362.             lY = lY + 2
  363.             DrawLine hdc, tR.left, tR.Right, lY, 1
  364.         Case 5
  365.             ' thin-thick-thin
  366.             lY = tR.tOp + (tR.Bottom - tR.tOp) \ 2
  367.             lY = lY - 3
  368.             DrawLine hdc, tR.left, tR.Right, lY, 1
  369.             lY = lY + 3
  370.             DrawLine hdc, tR.left, tR.Right, lY, 2
  371.             lY = lY + 2
  372.             DrawLine hdc, tR.left, tR.Right, lY, 1
  373.         End Select
  374.     End If
  375. End Sub
  376. Private Function DrawLine(ByVal hdc As Long, ByVal lXStart As Long, ByVal lXEnd As Long, ByVal lY As Long, ByVal lWidth As Long, Optional ByVal lStyle As Long = PS_SOLID)
  377. Dim hPen As Long
  378. Dim hPenOld As Long
  379. Dim tP As POINTAPI
  380.     hPen = CreatePen(lStyle, lWidth, GetSysColor(COLOR_WINDOWTEXT))
  381.     hPenOld = SelectObject(hdc, hPen)
  382.     MoveToEx hdc, lXStart, lY, tP
  383.     LineTo hdc, lXEnd, lY
  384.     SelectObject hdc, hPenOld
  385.     DeleteObject hPen
  386. End Function
  387. Private Sub cboLineStyle_MeasureItem(Index As Long, WidthPixels As Long, HeightPixels As Long)
  388.     WidthPixels = cboLineStyle.Width \ Screen.TwipsPerPixelX
  389.     HeightPixels = cboLineStyle.Height \ Screen.TwipsPerPixelY
  390. End Sub
  391. Private Sub Form_Load()
  392. Dim i As Long
  393.     With cboLineStyle
  394.         .AddItemAndData "
  395. ", , , , , 1, 25
  396.         .AddItemAndData "
  397. ", , , , , 1, 50
  398.         .AddItemAndData "
  399. ", , , , , 1, 75
  400.         .AddItemAndData "1", , , , , 1, 100
  401.         .AddItemAndData "1
  402. ", , , , , 1, 150
  403.         .AddItemAndData "2
  404. ", , , , , 1, 225
  405.         .AddItemAndData "3", , , , , 1, 300
  406.         .AddItemAndData "4
  407. ", , , , , 1, 450
  408.         .AddItemAndData "6", , , , , 1, 600
  409.         
  410.         .AddItemAndData "3", , , , , 2, 100
  411.         .AddItemAndData "4
  412. ", , , , , 3, 150
  413.         .AddItemAndData "4
  414. ", , , , , 4, 150
  415.         .AddItemAndData "6", , , , , 5, 150
  416.         
  417.         .ListIndex = 0
  418.     End With
  419.     With cboLineDash
  420.         .AddItemAndData "", , , , , PS_SOLID
  421.         .AddItemAndData "", , , , , PS_DASHDOT
  422.         .AddItemAndData "", , , , , PS_DASHDOTDOT
  423.         .AddItemAndData "", , , , , PS_DOT
  424.         .ListIndex = 0
  425.     End With
  426.     For i = picTexture.LBound To picTexture.UBound
  427.         cboBackTexture.AddItemAndData picTexture(i).Tag, , , , , i
  428.     Next i
  429.     cboBackTexture.AddItemAndData "None", , , , , -1
  430.     cboBackTexture.ItemOverLine(cboBackTexture.NewIndex) = True
  431.     cboBackTexture.ListIndex = 0
  432. End Sub
  433.